home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok03.lha / IFFtoCode / Sources / IFFtoCode.mod next >
Text File  |  1993-08-15  |  9KB  |  312 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    IFFtoCode.mod
  3.     :Author.     Pit Burkhardt
  4.     :Address.    Stettinerstraße 25, D-7030 Böblingen
  5.     :Phone.      (please let me sleep peacefully)
  6.     :Shortcut.   [pit]
  7.     :Version.    0.2
  8.     :Date.       13.06.88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    LoadIFF.mod [fbs]
  13.     :UpDate.     none
  14.     :Contents.   Umwandlung von IFF-Bildern in M2-Source-Code für ImageData.
  15.     :Remark.     Updated Version of V0.1
  16. ---------------------------------------------------------------------------*)
  17. MODULE IFFtoCode;
  18.  
  19. FROM SYSTEM IMPORT     ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST;
  20.  
  21. FROM Exec IMPORT    UByte;
  22.  
  23. FROM Intuition IMPORT     ScreenPtr,WindowPtr,CloseScreen,DisplayBeep;
  24.  
  25. FROM Arguments IMPORT     NumArgs,GetArg;
  26.  
  27. FROM Arts IMPORT    TermProcedure,Assert;    
  28.  
  29. FROM IFFLoad  IMPORT     ReadILBM,ReadILBMFlags,ReadILBMFlagSet,IFFInfo;
  30.  
  31. FROM Graphics IMPORT     RastPortPtr,BitMapPtr;
  32.  
  33. FROM InOut IMPORT    WriteString,WriteLn,WriteHex,WriteInt,OpenOutput,
  34.             CloseOutput;
  35.  
  36. FROM Strings IMPORT    Length,Copy,Insert;
  37.  
  38. VAR    MyScreen,
  39.     MyOldScreen    :ScreenPtr;
  40.     MyWindow    :WindowPtr;
  41.       Name,PtrName,
  42.         CurrentName,
  43.         CONSTName    :ARRAY[0..79] OF CHAR;
  44.         length,i,
  45.         Eingabe,
  46.         Durchgang    :INTEGER;
  47.       Error        :BOOLEAN;
  48.       len        :LONGINT;
  49.       BitMaps        :ARRAY[0..5] OF ADDRESS;
  50.         ScLineLength,
  51.         LineLength,
  52.         Plane        :LONGINT;
  53.         Pictheight,
  54.         Pictdepth,
  55.         Pictwidth    :LONGINT;
  56.         AnzEingaben    :INTEGER;
  57.       RP        :RastPortPtr;
  58.       BM        :BitMapPtr;
  59.         HeaderDone    :BOOLEAN;
  60.         mehrDim        :BOOLEAN;
  61.         AnzElem,Ae,
  62.         AnzZiff        :LONGINT;
  63.  
  64. PROCEDURE CleanUp;
  65.  BEGIN
  66.   IF MyScreen<>NIL THEN CloseScreen(MyScreen) END;
  67.  END CleanUp;
  68.  
  69.  
  70. PROCEDURE PointerName(Name:ARRAY OF CHAR;VAR PName:ARRAY OF CHAR);
  71.  VAR     l    :INTEGER;    
  72.  BEGIN
  73.   l:=Length(Name);
  74.   Copy(PName,Name,0,79);
  75.   Insert(PName,l,"Ptr");
  76.  END PointerName;
  77.  
  78.  
  79. PROCEDURE WritePlaneDat(BitMaps:ARRAY OF ADDRESS;Pictwidth,Pictheight,
  80.             Pictdepth,ScLineLength:LONGINT;
  81.                         Name,PtrName,CName:ARRAY OF CHAR);
  82.   VAR            Location    :POINTER TO UByte;
  83.                 Plane        :CARDINAL;
  84.                 Line,
  85.                 ByteStep,Bstep,
  86.                 Bs        :LONGINT;
  87.           Index       :CARDINAL;
  88.                 ItemsPerLine    :LONGINT;    
  89.  
  90. PROCEDURE WriteHeader(VAR Done:BOOLEAN);    (* Schreibt die Deklarationen *)
  91.  BEGIN   
  92.    
  93.    WriteLn;
  94.    WriteString("          (* -------> DEFINITION MODULE <-------- *)"); 
  95.    WriteLn;
  96.    WriteLn;
  97.    WriteString("DEFINITION MODULE "); WriteString(Name); WriteString(";");
  98.    WriteLn; WriteLn;
  99.    WriteString("FROM SYSTEM IMPORT      WORD;");
  100.    WriteLn; WriteLn;
  101.    WriteString("FROM Heap IMPORT        AllocMem;");
  102.    WriteLn; WriteLn;
  103.    
  104.    WriteString("TYPE    Img=RECORD"); WriteLn; 
  105.    WriteString("          Dat:ARRAY [0.."); WriteInt(AnzElem,AnzZiff);
  106.    WriteString("] OF WORD;"); WriteLn;
  107.    WriteString("        END;"); WriteLn;
  108.    WriteLn; WriteLn;
  109.    
  110.    IF mehrDim THEN
  111.     WriteString("CONST   ");
  112.     FOR i:=1 TO AnzEingaben DO
  113.       GetArg(i,CONSTName,length);
  114.       WriteString(CONSTName); WriteString("=");WriteInt(i-1,3);WriteString(";");
  115.       WriteLn; WriteString("        ");
  116.     END;
  117.     WriteLn; WriteLn;
  118.    END;
  119.    
  120.    WriteString("VAR     "); WriteString(Name); WriteString("width   :INTEGER;");
  121.    WriteLn;        
  122.    
  123.    WriteString("        "); WriteString(Name); WriteString("height  :INTEGER;");
  124.    WriteLn;        
  125.    
  126.    WriteString("        "); WriteString(Name); WriteString("depth   :INTEGER;");
  127.    WriteLn;        
  128.    
  129.    WriteString("        "); WriteString(PtrName); 
  130.    IF mehrDim THEN
  131.      WriteString("     :ARRAY [0.."); WriteInt(AnzEingaben-1,3);
  132.      WriteString("] OF POINTER TO Img;"); WriteLn;
  133.      WriteLn; WriteLn;
  134.    ELSE
  135.      WriteString("     :POINTER TO Img;");
  136.      WriteLn; WriteLn;        
  137.    END;
  138.    WriteString("END "); WriteString(Name); WriteString(".");
  139.    WriteLn; WriteLn; 
  140.    
  141.    
  142.    WriteString("          (* -------> IMPLEMENTATION MODULE <-------- *)"); 
  143.    WriteLn;
  144.    WriteLn;  
  145.    WriteString("IMPLEMENTATION MODULE "); WriteString(Name); WriteString(";");
  146.    WriteLn; WriteLn;
  147.    WriteString("FROM SYSTEM IMPORT      WORD;");
  148.    WriteLn; WriteLn;
  149.    WriteString("FROM Heap IMPORT        AllocMem;");
  150.    WriteLn; WriteLn;
  151.    
  152.    IF mehrDim THEN
  153.        WriteString("VAR     i   :INTEGER;");
  154.        WriteLn; WriteLn;
  155.    END;        
  156.    WriteLn; WriteLn;        
  157.    WriteString("BEGIN   (* MAIN *)");
  158.    WriteLn; WriteLn;         
  159.    
  160.    IF mehrDim THEN
  161.      WriteString("FOR i:=0 TO ");
  162.      WriteInt(AnzEingaben-1,3); WriteString("  DO"); WriteLn;
  163.      WriteString("  AllocMem(");     WriteString(PtrName); 
  164.      WriteString("[i],SIZE(");       WriteString(PtrName); 
  165.      WriteString("[i]^),TRUE);");     WriteLn;
  166.      WriteString("END;"); 
  167.    ELSE
  168.      WriteString("AllocMem(");     WriteString(PtrName); 
  169.      WriteString(",SIZE(");       WriteString(PtrName); 
  170.      WriteString("^),TRUE);");     WriteLn;
  171.    END;
  172.    
  173.    WriteLn; WriteLn;
  174.    WriteString(Name); WriteString("width"); WriteString(" :=");
  175.    WriteInt(Pictwidth*8,3); WriteString(";");
  176.    WriteLn;
  177.    
  178.    WriteString(Name); WriteString("height"); WriteString(":=");
  179.    WriteInt(Pictheight,3); WriteString(";");
  180.    WriteLn;
  181.    
  182.    WriteString(Name); WriteString("depth"); WriteString(" :=");
  183.    WriteInt(Pictdepth,3); WriteString(";");
  184.    WriteLn; WriteLn;
  185.  
  186.    Done:=TRUE;         
  187.  END WriteHeader;   
  188.  
  189. (* *********************  WritePlaneDat ********************* *)
  190.  
  191.   BEGIN                         
  192.    AnzElem:=Pictwidth*Pictdepth*Pictheight DIV 2-1;
  193.    Ae:=AnzElem;
  194.    AnzZiff:=1;
  195.    WHILE Ae>10 DO;
  196.      Ae:=Ae DIV 10;
  197.      AnzZiff:=AnzZiff+1;    (* Anzahl der Ziffern des größten Indexes *)  
  198.    END;
  199.    
  200.    IF AnzZiff<=3 THEN
  201.      ItemsPerLine:=4;
  202.    ELSE
  203.      ItemsPerLine:=3;
  204.    END;
  205.    
  206.    IF NOT HeaderDone THEN 
  207.      WriteHeader(HeaderDone);
  208.    END;
  209.    
  210.    WriteLn; WriteLn;
  211.    WriteString("WITH "); WriteString(PtrName);
  212.    IF mehrDim THEN
  213.      WriteString("["); WriteString(CName); WriteString("]");
  214.    END;
  215.    WriteString("^ DO         (* "); 
  216.    WriteString(CName); WriteString(" *)"); 
  217.    WriteLn;  
  218.    WriteLn;  
  219.    
  220.    Index:=0;
  221.    ItemsPerLine:=ItemsPerLine*2;        (* 2 Bytes per Item *)
  222.    (*Pictwidth:=Pictwidth*2;*)
  223.    FOR Plane := 0 TO Pictdepth-1 DO
  224.      WriteString("  (* Plane "); WriteInt(Plane+1,1); WriteString(" *)");
  225.      WriteLn;  
  226.      FOR Line := 0 TO Pictheight-1 DO
  227.         ByteStep:=0;
  228.         LOOP
  229.            Bstep:=ByteStep;
  230.            REPEAT
  231.               WriteString(" Dat[");        
  232.              WriteInt(Index,AnzZiff);
  233.               Index:=Index+1;
  234.               WriteString("]:=0");
  235.               FOR Bs:=Bstep TO Bstep+1 DO
  236.                  Location:=ADDRESS(BitMaps[Plane]+ ScLineLength*Line+Bs);
  237.                  WriteHex(Location^,2);    (* Hex-Wert schreiben *)
  238.           END; (*FOR Bs*)                
  239.               WriteString("H;");
  240.               Bstep:=Bstep+2;
  241.               IF Bs>=Pictwidth THEN     
  242.                 WriteString("(*"); WriteInt(Line+1,2); WriteString("*)");
  243.                 WriteLn;
  244.                 EXIT;            (*Ende der Zeile des Brushes erreicht*)
  245.               END;    
  246.            UNTIL Bstep>=ByteStep+ItemsPerLine;     
  247.            WriteLn; 
  248.            ByteStep:=ByteStep+ItemsPerLine;
  249.         END; (*LOOP*)
  250.      END; (*FOR Line*)
  251.      WriteLn;
  252.    END; (*FOR Plane*)
  253.  END WritePlaneDat;
  254.          
  255.                
  256. BEGIN (* MAIN *)
  257.   
  258.   Name:="Img";
  259.   
  260.   TermProcedure(CleanUp);
  261.   HeaderDone:=FALSE;
  262.   AnzEingaben:=NumArgs();
  263.   IF AnzEingaben>1 THEN mehrDim:=TRUE END;
  264.   WriteLn;
  265.   WriteString("IFFtoCode Version 0.2 by Pit Burkhardt"); 
  266.   WriteLn;WriteLn;
  267.   IF AnzEingaben=0 THEN
  268.     WriteString("Sorry, can't work - no Input!"); WriteLn;WriteLn;
  269.     WriteString("From CLI: Name IFF-file(s) as option."); WriteLn;WriteLn;
  270.     WriteString("From Workbench: <SHIFT>-klick IFF-file(s),"); WriteLn;
  271.     WriteString("then <SHIFT>-doubleklick IFFtoCode"); WriteLn; WriteLn;
  272.   ELSE
  273.     WriteString("Enter Name of Source-file to be generated or press <RETURN>"); 
  274.     WriteLn;
  275.     OpenOutput(" ");
  276.     PointerName(Name,PtrName);
  277.     FOR Eingabe:=1 TO AnzEingaben DO
  278.         Durchgang:=Eingabe-1;
  279.         GetArg(Eingabe,CurrentName,length);
  280.       MyOldScreen:=MyScreen;
  281.         IF MyOldScreen<>NIL THEN CloseScreen(MyOldScreen) END;
  282.         Error:=ReadILBM(CurrentName,ReadILBMFlagSet{visible},MyScreen,MyWindow);
  283.       Assert((Error),ADR("Fehler beim Laden des ILBM-Files"));
  284.       Pictdepth:=IFFInfo.BMHD.depth;
  285.       Pictheight:=IFFInfo.BMHD.height;
  286.       Pictwidth:=IFFInfo.BMHD.width;
  287.       LineLength := SHIFT(Pictwidth,-3);    (*ergibt Zeilenlänge in Bytes*)
  288.       IF LineLength*8<Pictwidth THEN
  289.           WriteString("(* Brushbreite gegenüber IFF geändert! *)"); WriteLn;
  290.           LineLength:=LineLength+2;
  291.       END;
  292.       ScLineLength:= SHIFT(MyScreen^.width,-3);
  293.       RP := ADR(MyScreen^.rastPort);
  294.       BM := RP^.bitMap;
  295.       FOR i:=0 TO Pictdepth-1 DO
  296.           BitMaps[i] := BM^.planes[i];
  297.       END;
  298.   
  299.       WritePlaneDat(BitMaps,LineLength,Pictheight,Pictdepth,ScLineLength,
  300.                       Name,PtrName,CurrentName);
  301.         WriteString("END; ");
  302.         WriteLn; 
  303.     END; (*FOR i*)
  304.     WriteString("END "); WriteString(Name); WriteString(".");
  305.     WriteLn;
  306.     CloseOutput; 
  307.     WriteLn;
  308.     WriteString("Thanks! It was a pleasure to work with you ..."); 
  309.     WriteLn;
  310.   END; (*IF*)
  311. END IFFtoCode.
  312.